Analyse de réseau avec R

0. Préparatifs

setwd("~/GitHub/UNIGE/32M7129/Cours_08")
#je charge les données que l'enseignant a préparé pour éviter les problèmes
#load("Cours_Geneve_8.RData")

if(!require("devtools")){
  install.packages("devtools")
  library(devtools)
}
if(!require("igraph")){
  install.packages("igraph")
  library(igraph)
}
if(!require("tidyverse")){
  install.packages("tidyverse")
  library(tidyverse)
}
if(!require("tidygraph")){
  install.packages("tidygraph")
  library(tidygraph)
}
if(!require("ggraph")){
  install.packages("ggraph")
  library(ggraph)
}
if(!require("qgraph")){
  install.packages("qgraph")
  library(qgraph)
}
if(!require("corrr")){
  install.packages("corrr")
  library(corrr)
}
if(!require("visNetwork")){
  install.packages("visNetwork")
  library(visNetwork)
}
if(!require("networkD3")){
  install.packages("networkD3")
  library(networkD3)
}
if(!require("ForceAtlas2")){
  devtools::install_github("analyxcompany/ForceAtlas2")
  library(ForceAtlas2)
}
if(!require("rgl")){
  install.packages("rgl")
  library(rgl)
}
if(!require("igraphdata")){
  install.packages("igraphdata")
  library(igraphdata)
}
if(!require("netrankr")){
  install.packages("netrankr")
  library(netrankr)
}
if(!require("popgraph")){
  devtools::install_github("dyerlab/popgraph")
  library(popgraph)
}
if(!require("ggmap")){
  install.packages("ggmap")
  library(ggmap)
}

Je charge mes deux fichiers: celui avec les nœuds (nodes.csv) et celui avec les arêtes (edges.csv).

nodes <- as.data.frame(read.csv(file="data/basic/nodes.csv", sep = "\t", header = FALSE))
edges <- as.data.frame(read.csv(file="data/basic/edges.csv", sep = "\t", header = FALSE))
#Je donne un nom aux colonnes de chaque data.frame
colnames(nodes) <- c("id", "label","type")
colnames(edges) <- c("from", "to")
#Je contrôle que tout est en ordre

J’affiche les premiers éléments de chaque fichier, et je compte les rangs pour me faire une idée de ce qui se trouve dans mes données

head(nodes)
head(edges)
nrow(nodes); length(unique(nodes$id))
nrow(edges); nrow(unique(edges[,c("from", "to")]))

##   id              label      type
## 1  1            Molière    Auteur
## 2  2 Guillaume de Luyne  Libraire
## 3  3      Claude Barbin  Libraire
## 4  4   Charles de Sercy  Libraire
## 5  5       Jean Hénault Imprimeur
## 6  6      François Noël Imprimeur
##   from to
## 1    1  2
## 2    1  3
## 3    1  4
## 4    1  5
## 5    1  6
## 6    1  7
## [1] 27
## [1] 27
## [1] 242
## [1] 106

Je transforme ces deux objets en données igraph, qui vont me permettre de faire mes analyses de réseau par la suite.

data <- graph_from_data_frame(d=edges, vertices=nodes, directed=F) 
class(data)

## [1] "igraph"

Mes données se présentent sous cette forme:

data

## IGRAPH 8c8a8f7 UN-B 27 242 -- 
## + attr: name (v/c), label (v/c), type (v/c)
## + edges from 8c8a8f7 (vertex names):
##  [1] 1 --2  1 --3  1 --4  1 --5  1 --6  1 --7  2 --3  2 --4  2 --5  2 --6 
## [11] 2 --7  3 --4  3 --5  3 --6  3 --7  4 --5  4 --6  4 --7  5 --6  5 --7 
## [21] 6 --7  1 --8  1 --9  1 --7  8 --9  7 --8  7 --9  1 --4  1 --2  1 --10
## [31] 1 --3  1 --12 1 --7  2 --4  4 --10 3 --4  4 --12 4 --7  2 --10 2 --3 
## [41] 2 --12 2 --7  3 --10 10--12 7 --10 3 --12 3 --7  7 --12 1 --2  1 --4 
## [51] 1 --10 1 --3  1 --12 1 --7  2 --4  2 --10 2 --3  2 --12 2 --7  4 --10
## [61] 3 --4  4 --12 4 --7  3 --10 10--12 7 --10 3 --12 3 --7  7 --12 1 --3 
## [71] 1 --12 1 --7  3 --12 3 --7  7 --12 1 --3  1 --12 1 --13 3 --12 3 --13
## + ... omitted several edges

Je peux désormais afficher les nœuds, les arêtes de cette manière. Je peux aussi sélectionner certaines colonnes pour chaque fichier d’une manière particulière aux objets igraph

#edges
E(data)
#nodes
V(data)
#nodes labels
V(data)$label
#nodes types
V(data)$type

## + 242/242 edges from 8c8a8f7 (vertex names):
##   [1] 1 --2  1 --3  1 --4  1 --5  1 --6  1 --7  2 --3  2 --4  2 --5  2 --6 
##  [11] 2 --7  3 --4  3 --5  3 --6  3 --7  4 --5  4 --6  4 --7  5 --6  5 --7 
##  [21] 6 --7  1 --8  1 --9  1 --7  8 --9  7 --8  7 --9  1 --4  1 --2  1 --10
##  [31] 1 --3  1 --12 1 --7  2 --4  4 --10 3 --4  4 --12 4 --7  2 --10 2 --3 
##  [41] 2 --12 2 --7  3 --10 10--12 7 --10 3 --12 3 --7  7 --12 1 --2  1 --4 
##  [51] 1 --10 1 --3  1 --12 1 --7  2 --4  2 --10 2 --3  2 --12 2 --7  4 --10
##  [61] 3 --4  4 --12 4 --7  3 --10 10--12 7 --10 3 --12 3 --7  7 --12 1 --3 
##  [71] 1 --12 1 --7  3 --12 3 --7  7 --12 1 --3  1 --12 1 --13 3 --12 3 --13
##  [81] 12--13 1 --2  1 --4  1 --14 1 --15 1 --16 1 --10 1 --3  1 --12 1 --5 
##  [91] 2 --4  2 --14 2 --15 2 --16 2 --10 2 --3  2 --12 2 --5  4 --14 4 --15
## + ... omitted several edges
## + 27/27 vertices, named, from 8c8a8f7:
##  [1] 1  2  3  4  5  6  7  8  9  10 12 13 14 15 16 17 18 19 20 21 22 23 24
## [24] 25 26 27 28
##  [1] "Molière"                  "Guillaume de Luyne"      
##  [3] "Claude Barbin"            "Charles de Sercy"        
##  [5] "Jean Hénault"             "François Noël"           
##  [7] "Christophe Journel"       "Sieur de Neuf-Villenaine"
##  [9] "Jean Ribou"               "Jean Guignard"           
## [11] "Gabriel Quinet"           "François II Noël"        
## [13] "Thomas Jolly"             "Louis Billaine"          
## [15] "Estienne Loyson"          "Claude Blageart"         
## [17] "Pierre Trabouillet"       "Nicolas Le Gras"         
## [19] "Théodore Girard"          "Etienne Maucroy"         
## [21] "Claude II Calleville"     "Claude Audinet"          
## [23] "Pierre Le Monnier"        "Pierre Corneille"        
## [25] "Philippe Quinault"        "Pierre Promé"            
## [27] "François Muguet"         
##  [1] "Auteur"    "Libraire"  "Libraire"  "Libraire"  "Imprimeur"
##  [6] "Imprimeur" "Imprimeur" "Libraire"  "Libraire"  "Libraire" 
## [11] "Libraire"  "Imprimeur" "Libraire"  "Libraire"  "Libraire" 
## [16] "Imprimeur" "Libraire"  "Libraire"  "Libraire"  "Imprimeur"
## [21] "Imprimeur" "Imprimeur" "Libraire"  "Auteur"    "Auteur"   
## [26] "Libraire"  "Imprimeur"

1. Mon premier graphe

Je peux désormais fabriquer mon réseau avec la fonction plot:

plot(data) 

Il existe une fonction alternative plot.igraph, qui fait la même chose

plot.igraph(data) 

Il existe enfin une fonction tkplot qui est un prototype d’interface utilisateur:

#tkplot(data)

Je dispose d’un grand nombre de paramètres pour modifier l’apparence de mon graph et le rendre (si on en a le talent) esthétique:

plot(data,
     #courbure de l'arête
     edge.curved=0.1,
     #couleur de l'arête
     edge.color="orange",
     #couleur du nœud
     vertex.color="green",
     #couleur du contour du nœud
     vertex.frame.color="#555555",
     #couleur de l'étiquette du nœud
     vertex.label.color="darkred",
     #contenu de l'étiquette du nœud
     vertex.label=V(data)$type,
     #taille de la police
     vertex.label.cex=1) 

On peut customiser encore plus la décoration en intervenant plus lourdement sur la mise en page. Une manière de faire va être de créer des vecteurs à partir des données, en substituant la valeur qui nous intéresse par la forme que l’on souhaite lui donner. Par exemple, si je veux changer la couleur du nœud en fonction du label

#J'ai une colonne de mon objet igraph avec les labels
V(data)$type
#je copie le contenu de cette colonne dans un nouvel objet
to_colors<-V(data)$type
#Je substitue toute les cellules avec l'information `libraire` par la couleur souhaitée
to_colors<-replace(to_colors,to_colors=="Libraire","orange")
to_colors
#Je continue avec les autres valeurs
to_colors<-replace(to_colors,to_colors=="Auteur","green")
to_colors<-replace(to_colors,to_colors=="Imprimeur","red")
#J'obtiens un nouvel objet avec des couleurs à la place des labels
to_colors

##  [1] "Auteur"    "Libraire"  "Libraire"  "Libraire"  "Imprimeur"
##  [6] "Imprimeur" "Imprimeur" "Libraire"  "Libraire"  "Libraire" 
## [11] "Libraire"  "Imprimeur" "Libraire"  "Libraire"  "Libraire" 
## [16] "Imprimeur" "Libraire"  "Libraire"  "Libraire"  "Imprimeur"
## [21] "Imprimeur" "Imprimeur" "Libraire"  "Auteur"    "Auteur"   
## [26] "Libraire"  "Imprimeur"
##  [1] "Auteur"    "orange"    "orange"    "orange"    "Imprimeur"
##  [6] "Imprimeur" "Imprimeur" "orange"    "orange"    "orange"   
## [11] "orange"    "Imprimeur" "orange"    "orange"    "orange"   
## [16] "Imprimeur" "orange"    "orange"    "orange"    "Imprimeur"
## [21] "Imprimeur" "Imprimeur" "orange"    "Auteur"    "Auteur"   
## [26] "orange"    "Imprimeur"
##  [1] "green"  "orange" "orange" "orange" "red"    "red"    "red"   
##  [8] "orange" "orange" "orange" "orange" "red"    "orange" "orange"
## [15] "orange" "red"    "orange" "orange" "orange" "red"    "red"   
## [22] "red"    "orange" "green"  "green"  "orange" "red"

Je peux désormais appliquer cette couleur à chaque nœud

#J'ai une colonne couleur qui est vide, que je vais remplir avec l'objet `to_colors` que je viens de créer
V(data)$color
#Je remplace la couleur du graphe avec celle que je viens de définir
V(data)$color <- to_colors
#Le graphe change de couleur
plot(data)

Je peux faire la même opération avec la forme des nœuds, et améliorer encore le rendu.

ATTENTION: le rendu dans RStudio n’est pas forcément optimum: pensez l’ouvrir dans une nouvelle fenêtre pour voir le résultat.

#On change la forme du nœud en fonction du label
to_shape<-V(data)$type
to_shape<-replace(to_shape,to_shape=="Auteur","square")
to_shape<-replace(to_shape,to_shape=="Imprimeur","circle")
to_shape<-replace(to_shape,to_shape=="Libraire","sphere")

#Je peux à nouveau changer l'objet igraph
V(data)$color <- to_colors
V(data)$label.color <- "black"
#E(data)$edge.color <- "gray80"

#ou bien intervenir directement dans les paramètres du graphe
plot(data,
     vertex.label.degree=2,
     #on injecte le vecteur avec les formes que nous venons de créer
     vertex.shape=to_shape,
     #taille des nœuds
     vertex.size = 10,
     #taille de la police
     vertex.label.cex=0.7
     ) 

title("mon graphe", sub="premier test")

#J'ajoute une petite légende
legend(x=-1.5, y=-1.1, c("Auteur","Libraire", "Imprimeur"), pch=21,
       col="#777777", pt.bg=c("green", "orange", "red"), pt.cex=2, cex=.8, bty="n", ncol=1)

Nous avons encore un problème: les relations multiples sont toutes dessinées, car elles sont restées dans le tableau. Quelles sont-elles?

Deux problèmes sont possibles: * Une boucle (loop) est un nœud relié par une arête à lui-même * Un multiple (multiple) sont deux nœuds reliés plusieurs fois ensemble. N.B. si le graph est dirigé 2->1 n’est pas un multiple de 1->2, mais s’il est dirigé oui.

which_loop(data)
which_multiple(data)

##   [1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
##  [12] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
##  [23] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
##  [34] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
##  [45] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
##  [56] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
##  [67] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
##  [78] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
##  [89] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [100] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [111] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [122] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [133] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [144] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [155] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [166] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [177] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [188] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [199] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [210] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [221] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [232] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
##   [1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
##  [12] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
##  [23] FALSE  TRUE FALSE FALSE FALSE  TRUE  TRUE FALSE  TRUE FALSE  TRUE
##  [34]  TRUE FALSE  TRUE FALSE  TRUE FALSE  TRUE FALSE  TRUE FALSE FALSE
##  [45] FALSE FALSE  TRUE FALSE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
##  [56]  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
##  [67]  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
##  [78] FALSE  TRUE FALSE FALSE  TRUE  TRUE FALSE FALSE FALSE  TRUE  TRUE
##  [89]  TRUE  TRUE  TRUE FALSE FALSE FALSE  TRUE  TRUE  TRUE  TRUE FALSE
## [100] FALSE FALSE  TRUE  TRUE  TRUE  TRUE FALSE FALSE FALSE FALSE FALSE
## [111] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE  TRUE
## [122]  TRUE FALSE  TRUE  TRUE FALSE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
## [133]  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
## [144]  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE FALSE  TRUE  TRUE  TRUE  TRUE
## [155]  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE FALSE  TRUE  TRUE  TRUE FALSE
## [166]  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE FALSE FALSE FALSE FALSE FALSE
## [177] FALSE FALSE FALSE FALSE FALSE  TRUE FALSE FALSE  TRUE FALSE FALSE
## [188]  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
## [199]  TRUE  TRUE FALSE FALSE  TRUE  TRUE  TRUE  TRUE FALSE  TRUE  TRUE
## [210] FALSE FALSE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE FALSE FALSE
## [221]  TRUE  TRUE  TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE  TRUE
## [232]  TRUE  TRUE FALSE  TRUE  TRUE FALSE FALSE  TRUE  TRUE FALSE FALSE

Comme j’ai de nombreux multiples, je vais les transformer en poids pour chaque arête

#Je compte les multiples pour chaque arête
count_multiple(data)
#Je fais une copie pour travailler dessus (si j'ai besoin des données originales plus tard)
data_simplified <- data
#Je copie-colle le nombre de multiple par arête dans la colonne des poids
E(data_simplified)$weight <- count_multiple(data_simplified)
#je retire les doublons (les multiples) avec la fonction simplify()
data_simplified <- simplify(data_simplified)

##   [1]  5  7  5  2  1  6  5  5  2  1  4  5  2  1  5  2  1  4  1  1  1  1 13
##  [24]  6  1  1  1  5  5  4  7  6  6  5  4  5  4  4  4  5  4  4  4  4  3  6
##  [47]  5  4  5  5  4  7  6  6  5  4  5  4  4  4  5  4  4  4  4  3  6  5  4
##  [70]  7  6  6  6  5  4  7  6  1  6  1  1  5  5  2  2  2  4  7  6  2  5  2
##  [93]  2  2  4  5  4  2  2  2  2  4  5  4  2  2  2  2  2  2  1  2  2  2  2
## [116]  1  2  2  2  1  4  4  1  6  2  1  5  2  5  2  2  4  7  6  6  2  5  2
## [139]  2  4  5  4  4  2  2  2  2  2  2  1  2  2  4  5  4  4  2  2  2  2  1
## [162]  2  2  2  1  4  4  3  6  5  4  1  1  1  1  1  1  1  1  1  1 13 11 10
## [185] 13  1  1 13 11 10 13 11 10 13 11 10 13 11 10 13  1  1 11 13 11 10  3
## [208] 11 13  3  3 10  3 11 13  3  3 10  1  2  3 13 11  1  1  1  1  1  1  1
## [231]  3  3 10  1 13 11  1  1 10  2  1  1

J’affiche mon nouveau graph: la largeur de l’arête dépend désormais du poids

E(data_simplified)$width <-E(data_simplified)$weight/2
plot(data_simplified,
     #pas de courbure de l'arête
     edge.curved=0,
     #distance entre le label et le nœud
     vertex.label.dist=1,
     #Choix de la police
     vertex.label.family="Times",
     #Choix de la forme
     vertex.shape=to_shape,
     # Taile du nœud
     vertex.size = 6,
     #taille de la police
     vertex.label.cex=0.6
     )
title("Et voilà!")
#J'ajoute une petite légende
legend(x=-2, y=-0.5, c("Auteur","Libraire", "Imprimeur"), pch=21,
       col="#777777", pt.bg=c("green", "orange", "red"), pt.cex=1, cex=.8, bty="n", ncol=1)

2. Tracé de graphe

Il existe différentes visualisation, algorithmes, etc. La logique est toujours la même: je pré-traite mon objet igraph avec une fonction spécifique au tracé choisi, et j’utilise le résultat de ce prétraitement comme valeur du paramètre layout. Ici, le circular layout:

to_circle<-layout_in_circle(data)
plot(data, layout=to_circle, vertex.size=1)

Il existe une multitude de layouts. Je peux tous les afficher d’un coup, pour jeter un coup d’œil à la forme qu’ils prennent, et choisir celui qui m’intéresse le plus

layouts <- grep("^layout_", ls("package:igraph"), value=TRUE)[-1] 
# J'en retire certains si je veux
layouts <- layouts[!grepl("bipartite|merge|norm|sugiyama|tree", layouts)]
#je prépare la mise en page du résultat
par(mfrow=c(3,3), mar=c(1,1,1,1))
#Je fais un boucle: un graph par itération
for (layout in layouts) {
  print(layout)
  l <- do.call(layout, list(data)) 
  plot(data_simplified, edge.arrow.mode=0, layout=l, main=layout) }

S’il y en a un qui m’intéresse, je peux l’appliquer de la même manière que pour le cercle.

Evidemment, je ne dois choisir un graphe adapté…

data("Koenigsberg")
plot(Koenigsberg)

Il semble que la forme en étoile soit bien adaptée, étant donné la centralité de Molière:

to_star<-layout_as_star(data)
plot(data, layout=to_star, vertex.size=0.1)

2.1 Les algorithmes forced base

Les tracés les plus importants sont les forced base, qui nécessitent des algorithmes particuliers. Regrdons-les en détail.

2.1.1 Fruchterman Reingold

Fruchterman, Thomas M. J.; Reingold, Edward M. (1991), “Graph Drawing by Force-Directed Placement”, Software – Practice & Experience, Wiley, 21 (11): 1129–1164, doi:10.1002/spe.4380211102.

Plus d’informations ici

Le algorithme est assez comppliqué, et le temprs de calcul conséquent. On l’utilise peu avec des grandes bases de données (plus de 10 000 nœuds).

layout_fr<-layout_with_fr(data_simplified)
E(data_simplified)$width <-E(data_simplified)$weight
plot(data_simplified, layout=layout_fr,
     #J'ajoute les poids
     weight=TRUE,
     #pas de courbure de l'arête
     edge.curved=0)

On peut jouer sur les paramètres et augmenter le nombre d’itération

#Je passe sur 2 colonnes, 2 rangs
par(mfrow=c(2, 2))
#J'ajuste la marge pour le titre
par(oma=c(1,1,1,1))

## layout_with_fr
plot.igraph(data_simplified, layout = layout_with_fr(data_simplified, niter = 1), main = 1)
plot.igraph(data_simplified, layout = layout_with_fr(data_simplified, niter = 5), main = 5)
plot.igraph(data_simplified, layout = layout_with_fr(data_simplified, niter = 10), main = 10)
plot.igraph(data_simplified, layout = layout_with_fr(data_simplified, niter = 20), main = 20)
plot.igraph(data_simplified, layout = layout_with_fr(data_simplified, niter = 50), main = 50)
plot.igraph(data_simplified, layout = layout_with_fr(data_simplified, niter = 75), main = 75)
plot.igraph(data_simplified, layout = layout_with_fr(data_simplified, niter = 100), main = 100)
plot.igraph(data_simplified, layout = layout_with_fr(data_simplified, niter = 150), main = 150)
plot.igraph(data_simplified, layout = layout_with_fr(data_simplified, niter = 200), main = 200)
plot.igraph(data_simplified, layout = layout_with_fr(data_simplified, niter = 300), main = 300)
plot.igraph(data_simplified, layout = layout_with_fr(data_simplified, niter = 500), main = 500)
plot.igraph(data_simplified, layout = layout_with_fr(data_simplified, niter = 700), main = 700)
title("No. of Iterations (layout_with_fr)", outer = TRUE)
par(mfrow=c(1, 1))
par(oma=c(0,0,0,0))

Voyons le résultat apèrs 700 itérations:

## J'épaissis l'arête en fonction du poids
E(data_simplified)$width <-E(data_simplified)$weight
plot.igraph(data_simplified,
            layout = layout_with_fr(data_simplified, niter = 700),
            main = 700,
            #pas de courbure de l'arête
            edge.curved=0,
            #taille de la police
            vertex.label.cex=0.6,
            # Taile du nœud
            vertex.size = 8)
title("700 itérations", outer = TRUE)

2.1.2 DrL

Le nom a changé plusieurs fois: d’abord rebaptisé vxOrd, on parle d’OpenOrd.

• Martin, S., Brown, W.M., Klavans, R., Boyack, K.W., DrL: Distributed Recursive (Graph) Layout. SAND Reports, 2008. 2936: p. 1-10.
• S. Martin, W. M. Brown, R. Klavans, and K. Boyack (to appear, 2011), “OpenOrd: An Open-Source Toolbox for Large Graph Layout,” SPIE Conference on Visualization and Data Analysis (VDA).

Plus d’informations ici

Il va tenter de faire ressortir au maximum des grands clusters très nets en coupant les liens les plus longs. Evidemment cet algorithme nécessite des graphes de grande taille, nous chargeons donc un gros jeu de données tiré du package igraphdata.

data("USairports")
#On trace le graphe
layout_drl <- layout.drl(USairports)
plot(USairports, layout=layout_drl, main="DrL")

Nous pouvons comparer l’effet de ce découpage avec celui effectué par l’algorithme précédent, Fruchterman Reingold

par(mfrow=c(1, 2))
par(oma=c(0,0,2,0))
plot(USairports, layout=layout_with_fr(USairports), weight=T, main="FR")
plot(USairports, layout=layout_drl, main="DrL")

2.2 le Geolayout

J’ai préparé un tout petit jeu de données avec des coordonnées géographiques

nodes_geo <- as.data.frame(read.csv(file="data/geo/nodes.csv", sep = "\t", header = FALSE))
edges_geo <- as.data.frame(read.csv(file="data/geo/edges.csv", sep = "\t", header = FALSE))
#Je donne un nom aux colonnes de chaque data.frame
colnames(nodes_geo) <- c("id", "label","lat","long")
colnames(edges_geo) <- c("from", "to")
nodes_geo
edges_geo

##   id     label      lat      long
## 1  1     Paris 48.86472  2.349014
## 2  2 Bruxelles 50.85045  4.348780
## 3  3    Geneve 46.20439  6.143158
## 4  4   Londres 51.50853 -0.125740
##   from to
## 1    1  2
## 2    1  3
## 3    1  4

Je transforme ces deux objets en données igraph, qui vont me permettre de faire mes analyses de réseau par la suite.

data_geo <- graph_from_data_frame(d=edges_geo, vertices=nodes_geo, directed=F) 
class(data_geo)
plot(data_geo)

Je projette ce réseau sur une carte, en plaçant les nœuds en fonction de leurs coordonnées géographiques

#Je définis les lat et long de mon cadre
western_europe<-c(left = -12, bottom = 40, right = 20, top = 55)
#Je récupère mon fond de carte selon les dimensions prévues supra
map <- get_stamenmap(western_europe, zoom=6, source="stamen", maptype="toner-lite", filetype="png")
#Je crée une carte à partir de mon fond de carte
p<-ggmap(map)
#J'ajoute les arêtes
p = p + geom_edgeset(aes(x=long, y=lat), data_geo, colour=gray(0.1, 0.3), size=1)
#J'ajoute les nœuds
p = p + geom_nodeset(aes(x=long, y=lat), data_geo, size=3, colour="red")
#J'affiche le tout
p

3. La force des liens

3.1 Les mesures

Densité (density): la proportion de liens dans un réseau relativement au total des liens possibles.

edge_density(data)

## [1] 0.6894587

Centralité de proximité: Distance moyenne du nœud à tous les autres nœuds (Closeness)

closeness.cent <- closeness(data)
closeness.cent

##          1          2          3          4          5          6 
## 0.03846154 0.02439024 0.02500000 0.02439024 0.02439024 0.02173913 
##          7          8          9         10         12         13 
## 0.02564103 0.02040816 0.02380952 0.02380952 0.02439024 0.02040816 
##         14         15         16         17         18         19 
## 0.02380952 0.02380952 0.02380952 0.02173913 0.02083333 0.02083333 
##         20         21         22         23         24         25 
## 0.02083333 0.02083333 0.02000000 0.02000000 0.02127660 0.02127660 
##         26         27         28 
## 0.02173913 0.02040816 0.02000000

Pour rappel, les noms attachés sont accessibles ainsi:

cbind(V(data)$label,closeness.cent)

##                               closeness.cent      
## 1  "Molière"                  "0.0384615384615385"
## 2  "Guillaume de Luyne"       "0.024390243902439" 
## 3  "Claude Barbin"            "0.025"             
## 4  "Charles de Sercy"         "0.024390243902439" 
## 5  "Jean Hénault"             "0.024390243902439" 
## 6  "François Noël"            "0.0217391304347826"
## 7  "Christophe Journel"       "0.0256410256410256"
## 8  "Sieur de Neuf-Villenaine" "0.0204081632653061"
## 9  "Jean Ribou"               "0.0238095238095238"
## 10 "Jean Guignard"            "0.0238095238095238"
## 12 "Gabriel Quinet"           "0.024390243902439" 
## 13 "François II Noël"         "0.0204081632653061"
## 14 "Thomas Jolly"             "0.0238095238095238"
## 15 "Louis Billaine"           "0.0238095238095238"
## 16 "Estienne Loyson"          "0.0238095238095238"
## 17 "Claude Blageart"          "0.0217391304347826"
## 18 "Pierre Trabouillet"       "0.0208333333333333"
## 19 "Nicolas Le Gras"          "0.0208333333333333"
## 20 "Théodore Girard"          "0.0208333333333333"
## 21 "Etienne Maucroy"          "0.0208333333333333"
## 22 "Claude II Calleville"     "0.02"              
## 23 "Claude Audinet"           "0.02"              
## 24 "Pierre Le Monnier"        "0.0212765957446809"
## 25 "Pierre Corneille"         "0.0212765957446809"
## 26 "Philippe Quinault"        "0.0217391304347826"
## 27 "Pierre Promé"             "0.0204081632653061"
## 28 "François Muguet"          "0.02"

Centralité d’intermédiarité: Nombre de fois que le nœud se trouve sur le plus court chemin entre deux autres nœuds (Betweenness)

closeness.bet <- betweenness(data)
closeness.bet

##           1           2           3           4           5           6 
## 222.8397763   0.9600000   4.3209524   0.9600000   0.3900000   0.0000000 
##           7           8           9          10          12          13 
##   5.0683883   0.0000000  10.2680258   0.0000000   2.3714286   0.0000000 
##          14          15          16          17          18          19 
##   0.0000000   0.0000000   0.0000000   0.9166667   0.0000000   0.0000000 
##          20          21          22          23          24          25 
##   0.0000000   0.0000000   0.0000000   0.0000000   0.0000000   0.0000000 
##          26          27          28 
##   0.9047619   0.0000000   0.0000000

Centralité de vecteurs propres: Score d’autorité attribué à un nœud en fonction du score de ses voisins. (Eigenvector).

closeness.eig <- eigen_centrality(data)
closeness.eig$vector

##          1          2          3          4          5          6 
## 1.00000000 0.56536647 0.65991521 0.56536647 0.23172674 0.10190675 
##          7          8          9         10         12         13 
## 0.55278661 0.06001095 0.55255801 0.48574803 0.58647420 0.06403130 
##         14         15         16         17         18         19 
## 0.27379413 0.27379413 0.27379413 0.49263907 0.03116947 0.03116947 
##         20         21         22         23         24         25 
## 0.03116947 0.03116947 0.04425426 0.04425426 0.17947299 0.06611127 
##         26         27         28 
## 0.09469017 0.05829650 0.03120315

Centralité de degré: Nombre de connexions du nœud (Degree)

closeness.deg <- degree(data_simplified)
closeness.deg

##  1  2  3  4  5  6  7  8  9 10 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 
## 82 36 42 36 15  6 33  3 33 30 36  3 18 18 18 27  4  4  4  4  2  2 11  5  7 
## 27 28 
##  3  2

On peut réutiliser ces données pour la visualisation, en ajustant la taille des nœuds à la centralité de degré

V(data_simplified)$size <- (closeness.deg*0.3)
plot(data_simplified, layout=layout_fr, main="FR")

On peut ajuster cette taille avec d’autres mesures de centralité, comme la centralité de vecteur

V(data_simplified)$size <- (closeness.eig$vector*30)
plot(data_simplified, layout=layout_fr, main="FR")

3.2 Un exemple d’analyse de la centralité

Tentons une approche plus pratique avec un réseau célèbre: celui de la Florence de la Renaissance (disponible dans le package netrankr).

data("florentine_m")
#Une famille n'est pas reliée aux autres: la famille Pucci
degree(florentine_m)==0
#On la retire pour simplifier la visualisation
florence <- delete_vertices(florentine_m,which(degree(florentine_m)==0))

## Acciaiuol   Albizzi Barbadori  Bischeri Castellan    Ginori  Guadagni 
##     FALSE     FALSE     FALSE     FALSE     FALSE     FALSE     FALSE 
## Lambertes    Medici     Pazzi   Peruzzi     Pucci   Ridolfi  Salviati 
##     FALSE     FALSE     FALSE     FALSE      TRUE     FALSE     FALSE 
##   Strozzi Tornabuon 
##     FALSE     FALSE

J’obtiens un joli graphe:

plot.igraph(florence, layout = layout_with_fr(florence, niter = 500),
                      main = "Florence au XVème s.")

Je peux proportionner la taille des nœuds en fonction de la fortune de chaque famille:

plot(florence,
     layout = layout_with_fr(florence, niter = 500),
     vertex.label.cex=V(florence)$wealth*0.012,
     vertex.size=V(florence)$wealth*0.2)

Mais est-ce que la richesse fait tout? Probablement pas… tentons d’évaluer la centralité des différentes familles

#Je fais un data-frame à partir de différents calculs de centralité
cent.data_frame <- data.frame(
  degree = degree(florence),
  betweenness = betweenness(florence),
  closeness = closeness(florence),
  eigenvector = eigen_centrality(florence)$vector,
  subgraph = subgraph_centrality(florence))
#Je peux accéder au résultat sous la forme de tableau qui résume toutes les données
View(cent.data_frame)

# Je donne le nom de la famille la plus centrale pour chaque mesure
V(florence)$name[apply(cent.data_frame,2,which.max)]

## [1] "Medici" "Medici" "Medici" "Medici" "Medici"

4. Visualiser

Il est possible de proposer une foule de visualisation. Par exemple, il est possible de remplacer les labels par la distance qui sépare un nœud d’un autre – ici, Thomas Jolly.

dist.thoJo <- distances(data, v=V(data)[label=="Thomas Jolly"], to=V(data), weights=NA)
# Set colors to plot the distances:

green.dark <- colorRampPalette(c("darkgreen", "lightgreen"))
col <- green.dark(max(dist.thoJo)+1)
col <- col[dist.thoJo+1]

plot(data, vertex.color=col, vertex.label=dist.thoJo)

On peut mettre en valeur le chemin le plus court entre deux poins

mon_chemin <- shortest_paths(data, 
                            from = V(data)[label=="Thomas Jolly"], 
                             to  = V(data)[label=="Pierre Corneille"],
                            #je colorie le nœud et l'arête
                             output = "both")

# On génère une couleur pour les arêtes en fonction du chemin
couleur_arc <- rep("gray80", ecount(data))
couleur_arc[unlist(mon_chemin$epath)] <- "orange" 
"Couleur des arcs"
couleur_arc #cf. 128 et 219

# On génère une largeur pour l'arête en fonction du chemin
largeur_arc <- rep(2, ecount(data))
largeur_arc[unlist(mon_chemin$epath)] <- 6
"Largeur des arcs"
largeur_arc #cf. 128 et 219

# Generate node color variable to plot the path:
coleur_noeud <- rep("gray40", vcount(data))
coleur_noeud[unlist(mon_chemin$vpath)] <- "gold"
"Les nœuds"
coleur_noeud #cf. 1 et 13

plot(data, vertex.color=coleur_noeud, edge.color=couleur_arc, 
     edge.width=largeur_arc, edge.arrow.mode=0)

On peut aussi regrouper en cluster les données, que l’on représente en dendogramme, comme pour la stylométrie

ceb <- cluster_edge_betweenness(data) 
dendPlot(ceb, mode="hclust")

Je projette ensuite ma classification sur mon graph

plot(ceb, data) 

On peut l’afficher en 3d. Pour cela j’utilise le paramètre dim=3 pour mon layout.

coords <- layout_with_fr(data_simplified, dim=3)
open3d()
rglplot(data, layout=coords)

Je peux faire une sauvegarde, notamment en HTML pour l’ouvrir dans le navigateur

dirfolder=getwd()
#open3d plutôt que rgl.open() pour une sauvegarde
open3d()
rglplot(data_simplified, layout=coords)

#Je prépare l'angle
rgl.viewpoint(theta=0, phi=0)

#Sauvegarder un screenshot (en png)
rgl.snapshot(paste(dirfolder,"monGRaph3d.png",sep=""), fmt="png", top=TRUE)

#Sauvegarde en html
rglfolder=writeWebGL(dir = paste(dirfolder,"first_net3d",sep=""), width=900)

#J'ouvre le résultat dans le navigateur
browseURL(rglfolder)

Je peux produire une visualisation interactive directement dans R. Je prépare les données

# je convertis mon igraphe en une liste  composée de deux data.frames (nodes et edges)
data_3d_vis <- toVisNetworkData(data)

# Pour le menu déroulant (cf infra)
names <- sort(data_3d_vis$nodes$label)

Et je lance une visualisation en 3D

visNetwork(nodes = data_3d_vis$nodes,
           edges = data_3d_vis$edges,
           main = "Mon graphe interactif",
           submain = "Alogirhtme de Fruchterman–Reingold",
           footer = "Wow") %>%
  #Je trace le graphe
  visIgraphLayout(layout = "layout_with_fr", 
                  smooth = FALSE,
                  #J'ajoute de la dynamique (cf. _infra_)
                  physics = TRUE
                )

Je rajoute des options de visualisation, comme une modification des nœuds s’ils sont sélectionnés, ou un selecteur sous la forme de liste déroulante

visNetwork(nodes = data_3d_vis$nodes,
           edges = data_3d_vis$edges,
           main = "Mon graphe interactif",
           submain = "Alogirhtme de Fruchterman–Reingold",
           footer = "Wow") %>%
  #Je trace le graphe
  visIgraphLayout(layout = "layout_with_fr", 
                  smooth = FALSE,
                  #J'ajoute de la dynamique (cf. _infra_)
                  physics = TRUE
                ) %>%
  #Je mets en valeur les nœuds liés
  visOptions(highlightNearest = list(enabled = TRUE,
                                     #séparés de 1 degré
                                     degree = 1,
                                     #il s'illuminent quand la souris passe sur le nœud
                                     hover = TRUE),
             #Je crée un sélecteur
             nodesIdSelection = list(enabled = TRUE,
                                     values = names))

Je vais avoir besoin “d’écarter” mon graphe, en ajoutant de la répulsion entre les nœuds (ce qui n’est pas tâche facile…)

data_3d_vis_plot <- visNetwork(nodes = data_3d_vis$nodes,
                               edges = data_3d_vis$edges,
                               main = "Mon graphe interactif",
                               submain = "Alogirhtme de Fruchterman–Reingold",
                               footer = "Wow") %>%
                    #Je trace le graphe
                    visIgraphLayout(layout = "layout_with_fr", 
                                    smooth = FALSE,
                                    #J'ajoute de la dynamique (cf. _infra_)
                                    physics = TRUE
                                    ) %>%
                    #Je mets en valeur les nœuds liés
                    visOptions(highlightNearest = list(enabled = TRUE,
                                                      #séparés de 1 degré
                                                      degree = 1,
                                                      #passage souris
                                                      hover = TRUE),
                              #Je crée un sélecteur
                              nodesIdSelection = list(enabled = TRUE,
                                                      values = names)
                              ) %>%
                    #taille des nœuds
                    visNodes(size = 50) %>%
                    #couleur des arêtes
                    visEdges(color = list(highlight = "lightgray")) %>%
                    #Je paramètre la répulsion
                    visPhysics(#Vélocité des nœuds
                               maxVelocity = 1,
                               #type de répulsion hiérarchique
                               solver = "forceAtlas2Based",
                               #paramètres du forceAtlas2Based
                               #la `gravitationalConstant` décrit la répulsion (l'écartement entre les nœuds), le chiffre est donc négatif, sinon oncrée de l'attraction
                               forceAtlas2Based = list(gravitationalConstant = -1000)
                     )

data_3d_vis_plot

5. Sauvegardes

On sauvegarde le résultat

write_graph(data, "edgelist.txt", format="edgelist")
svg(file="monGraph.svg")
plot(data)
dev.off()

png(file="monGraph.png")
plot(data)
dev.off()

100% center

100% center